home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / WIN_PRO / DS-2.ZIP;1 / TESTS.ZIP / COLLATE.ICN < prev    next >
Encoding:
Text File  |  1992-02-10  |  1.9 KB  |  79 lines
  1. procedure main()
  2.    s1 := collate(&cset,&cset)
  3.    s2 := collate(reverse(&cset),reverse(&cset))
  4.    write(image(decollate(s1,0)))
  5.    write(image(decollate(s1,1)))
  6.    write(image(decollate(s2,1)))
  7.    write(image(decollate(s2,0)))
  8.    perm()
  9. end
  10.  
  11. procedure collate(s1,s2)
  12.   local length, ltemp, rtemp, t
  13.   static llabels, rlabels, clabels, blabels, half
  14.   initial {
  15.     llabels := "abxy"
  16.     rlabels := "cduv"
  17.     blabels := llabels || rlabels
  18.     clabels := "acbdxuyv"
  19.     half := 4
  20.     ltemp := left(&cset,*&cset/2)
  21.     rtemp := right(&cset,*&cset/2)
  22.     clabels := collate(ltemp,rtemp)
  23.     llabels := ltemp
  24.     rlabels := rtemp
  25.     blabels := string(&cset)
  26.     half := *llabels
  27.     }
  28.    if *s1 > *s2 then {
  29.       t := s1[*s2+1:0]
  30.       s1 := s1[1:*s2+1]
  31.       }
  32.    else if *s2 > *s1 then {
  33.       t := s2[*s1+1:0]
  34.       s2 := s2[1:*s1+1]
  35.       }
  36.    else t := ""
  37.   length := *s1
  38.   if length <= half then
  39.     return map(left(clabels,2*length),left(llabels,length) ||
  40.       left(rlabels,length),s1 || s2) || t
  41.   else
  42.     return map(clabels,blabels,left(s1,half) || left(s2,half)) ||
  43.       collate(right(s1,length-half),right(s2,length-half)) || t
  44. end
  45.  
  46. procedure decollate(s,n)
  47.    static dsize, image, object
  48.    local ssize
  49.    initial {
  50.       image := collate(&cset[2:0],repl(&cset[1],*&cset-1))
  51.       object := string(&cset)
  52.       dsize := *image
  53.       }
  54.    n %:= 2
  55.    ssize := *s
  56.    if ssize + n <= dsize then
  57.       return map(object[1+:(ssize+n)/2],image[(n+1)+:ssize],s)
  58.    else
  59.       return map(object[1+:(dsize-2)/2],image[(n+1)+:dsize-2],
  60.          s[1+:(dsize-2)]) || decollate(s[dsize-1:0],n)
  61. end
  62. procedure perm()
  63.    output := set()
  64.    every 1 to 2 do
  65.       every insert(output,permute("ogram"))
  66.    every write(!sort(output))
  67. end
  68.  
  69. procedure permute(s)
  70.    local i, x, t
  71.    if s == "" then return ""
  72.    every i := 1 to *s do {
  73.       x := s[i]
  74.       t := s
  75.       t[i] := ""
  76.       suspend x || permute(t)
  77.       }
  78. end
  79.